home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / detect2r / mhdock.ctl < prev    next >
Text File  |  1999-08-31  |  5KB  |  141 lines
  1. VERSION 5.00
  2. Begin VB.UserControl MHDock 
  3.    Alignable       =   -1  'True
  4.    CanGetFocus     =   0   'False
  5.    ClientHeight    =   465
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   480
  9.    InvisibleAtRuntime=   -1  'True
  10.    Picture         =   "MHDock.ctx":0000
  11.    ScaleHeight     =   465
  12.    ScaleWidth      =   480
  13.    ToolboxBitmap   =   "MHDock.ctx":0442
  14. End
  15. Attribute VB_Name = "MHDock"
  16. Attribute VB_GlobalNameSpace = False
  17. Attribute VB_Creatable = True
  18. Attribute VB_PredeclaredId = False
  19. Attribute VB_Exposed = False
  20. Option Explicit
  21.  
  22. 'Default Property Values:
  23. Const m_def_xDock = 360
  24. Const m_def_yDock = 360
  25. Const m_def_DockEnabled = True
  26.  
  27. ' Saved local variables
  28. Dim seVars As seVarsType, hMem As Long
  29. Event Moved(xDockPos As Single, yDockPos As Single)
  30. Attribute Moved.VB_Description = "Event fires when the form is moved."
  31.  
  32. ' Copy from seVars structure to locked memory
  33. Private Sub seVarsChanged()
  34.     If hMem Then CopyMemory ByVal hMem, seVars, LenB(seVars)
  35. End Sub
  36.  
  37. ' Fired from the subclass procedure to cause a form Moved event
  38. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  39.     If hMem Then
  40.         X = X \ Screen.TwipsPerPixelX
  41.         Y = Y \ Screen.TwipsPerPixelY
  42.         RaiseEvent Moved(X, Y)
  43.     End If
  44. End Sub
  45.  
  46. ' Don't allow resizing during design
  47. Private Sub UserControl_Resize()
  48.     Height = 465: Width = 480
  49. End Sub
  50.  
  51. ' Reset the WndProc if needed
  52. Private Sub UserControl_Terminate()
  53.     On Local Error Resume Next
  54.     SetHook seVars.lParenthWnd, False, seVars.origWndProc
  55.     DeleteSetting "MHDock", "hMem", CStr(seVars.lParenthWnd)
  56.     GlobalFree hMem
  57. End Sub
  58.  
  59. Public Property Get DockEnabled() As Boolean
  60. Attribute DockEnabled.VB_Description = "Active docking capabilities"
  61.     DockEnabled = seVars.bDockEnabled
  62. End Property
  63.  
  64. Public Property Let DockEnabled(ByVal New_DockEnabled As Boolean)
  65.     seVars.bDockEnabled = New_DockEnabled
  66.     Call seVarsChanged
  67.     PropertyChanged "DockEnabled"
  68. End Property
  69.  
  70. Public Property Get xDock() As Long
  71. Attribute xDock.VB_Description = "Horizontal docking offset in Twips."
  72.     xDock = seVars.lxDock
  73. End Property
  74.  
  75. Public Property Let xDock(ByVal New_xDock As Long)
  76.     seVars.lxDock = New_xDock
  77.     Call seVarsChanged
  78.     PropertyChanged "xDock"
  79. End Property
  80.  
  81. Public Property Get yDock() As Long
  82. Attribute yDock.VB_Description = "Vertical docking offset in Twips."
  83.     yDock = seVars.lyDock
  84. End Property
  85.  
  86. Public Property Let yDock(ByVal New_yDock As Long)
  87.     seVars.lyDock = New_yDock
  88.     Call seVarsChanged
  89.     PropertyChanged "yDock"
  90. End Property
  91.  
  92. Private Sub UserControl_InitProperties()
  93.     seVars.lxDock = m_def_xDock
  94.     seVars.lyDock = m_def_yDock
  95.     Call seVarsChanged
  96. End Sub
  97.  
  98. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  99.     seVars.lxDock = PropBag.ReadProperty("xDock", m_def_xDock)
  100.     seVars.lyDock = PropBag.ReadProperty("yDock", m_def_yDock)
  101.     seVars.bDockEnabled = PropBag.ReadProperty("DockEnabled", m_def_DockEnabled)
  102.     
  103.     If Ambient.UserMode Then    ' Run-time only
  104.         Dim h As Long, f As Object, R As RECT
  105.         
  106.         ' Find the parent form's hWnd
  107.         For Each f In ParentControls
  108.             If TypeOf f Is Form Then
  109.                 seVars.lParenthWnd = f.hwnd
  110.                 Exit For
  111.             End If
  112.         Next
  113.         If seVars.lParenthWnd = 0 Then Exit Sub
  114.         
  115.         seVars.lseHwnd = hwnd
  116.         
  117.         ' Retrieve the parent handle and, if the window is top level, the system tray handle
  118.         seVars.lTophWnd = GetParent(seVars.lParenthWnd)
  119.         If seVars.lTophWnd = 0 Then
  120.             seVars.lTophWnd = GetDesktopWindow()
  121.             If seVars.lTrayhWnd = 0 Then seVars.lTrayhWnd = FindWindow("Shell_TrayWnd", vbNullString)
  122.         End If
  123.         
  124.         ' Store the original WndProc address in seVars, allocate fixed global
  125.         ' memory, and copy the seVars structure to the fixed memory
  126.         seVars.origWndProc = GetWindowLong(seVars.lParenthWnd, GWL_WNDPROC)
  127.         hMem = GlobalAlloc(GPTR, LenB(seVars))
  128.         SaveSetting "MHDock", "hMem", CStr(seVars.lParenthWnd), CStr(hMem)
  129.         Call seVarsChanged
  130.         
  131.         ' Hook the parent WndProc
  132.         SetHook seVars.lParenthWnd, True, seVars.origWndProc
  133.     End If
  134. End Sub
  135.  
  136. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  137.     Call PropBag.WriteProperty("xDock", seVars.lxDock, m_def_xDock)
  138.     Call PropBag.WriteProperty("yDock", seVars.lyDock, m_def_yDock)
  139.     Call PropBag.WriteProperty("DockEnabled", seVars.bDockEnabled, m_def_DockEnabled)
  140. End Sub
  141.